home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / encrypt2 / encrypt.frm next >
Text File  |  1997-08-17  |  4KB  |  155 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Encryption Example"
  4.    ClientHeight    =   3750
  5.    ClientLeft      =   1665
  6.    ClientTop       =   1740
  7.    ClientWidth     =   6690
  8.    Height          =   4155
  9.    Left            =   1605
  10.    LinkTopic       =   "Form1"
  11.    LockControls    =   -1  'True
  12.    ScaleHeight     =   3750
  13.    ScaleWidth      =   6690
  14.    Top             =   1395
  15.    Width           =   6810
  16.    Begin VB.CommandButton Command2 
  17.       Caption         =   "Decrypt"
  18.       Height          =   375
  19.       Left            =   4800
  20.       TabIndex        =   3
  21.       Top             =   3120
  22.       Width           =   1455
  23.    End
  24.    Begin VB.CommandButton Command1 
  25.       Caption         =   "Encrypt"
  26.       Height          =   375
  27.       Left            =   3000
  28.       TabIndex        =   2
  29.       Top             =   3120
  30.       Width           =   1575
  31.    End
  32.    Begin VB.TextBox Text2 
  33.       Height          =   375
  34.       Left            =   480
  35.       TabIndex        =   1
  36.       Top             =   3120
  37.       Width           =   2295
  38.    End
  39.    Begin VB.TextBox Text1 
  40.       Height          =   2535
  41.       Left            =   480
  42.       MultiLine       =   -1  'True
  43.       ScrollBars      =   3  'Both
  44.       TabIndex        =   0
  45.       Top             =   360
  46.       Width           =   5775
  47.    End
  48. End
  49. Attribute VB_Name = "Form1"
  50. Attribute VB_Creatable = False
  51. Attribute VB_Exposed = False
  52. Option Explicit
  53.  
  54.    Dim Key(1 To 20) As Integer
  55.  
  56.    Private Type cryptrecord
  57.       code As Integer
  58.    End Type
  59.  
  60. Private Sub Command1_Click()
  61.  
  62.    Dim crypt As cryptrecord
  63.    Dim n As Long
  64.    Dim i As Integer
  65.    
  66.    If Len(Text2.Text) < 3 Then
  67.       MsgBox "Password must be 3 to 20 characters long.", 0, "Password Needed"
  68.    Else
  69.       
  70.       'If password is longer than 20, only use the first 20 characters...
  71.       
  72.       If Len(Text2.Text) > 20 Then
  73.          Text2.Text = Left(Text2.Text, 20)
  74.       End If
  75.       
  76.       'We'll use the length of the password to repeat it...
  77.       
  78.       For i = 1 To Len(Text2.Text)
  79.          Key(i) = Asc(Mid(Text2.Text, i, 1)) + i
  80.       Next
  81.       
  82.       'Set i = 1 to be able to increment through Key(i)...
  83.       
  84.       i = 1
  85.       
  86.       'Open the file...
  87.       
  88.       Open "c:\coded.dat" For Random As #1 Len = Len(crypt)
  89.       For n = 1 To Len(Text1.Text)
  90.          
  91.          'Add the ASCII value of Key(i) to the ASCII value
  92.          'of the next character in Text1.Text...
  93.          
  94.          crypt.code = Asc(Mid(Text1.Text, n, 1)) + Key(i)
  95.          
  96.          'Increment i...
  97.          
  98.          i = i + 1
  99.          
  100.          'If i is larger than the lenght of the password, reset it...
  101.          
  102.          If i > Len(Text2.Text) Then
  103.             i = 1
  104.          End If
  105.          
  106.          Put #1, n, crypt.code
  107.       Next
  108.       Close #1
  109.       Text1.Text = "Done!"
  110.       Text2.Text = ""
  111.    End If
  112.  
  113. End Sub
  114.  
  115.  
  116. Private Sub Command2_Click()
  117.  
  118.    Dim crypt As cryptrecord
  119.    Dim n, filelength As Long
  120.    Dim i As Integer
  121.    Dim temp As String * 1
  122.    Text1.Text = ""
  123.    
  124.    If Len(Text2.Text) < 3 Then
  125.       MsgBox "Password must be 3 to 20 characters long.", 0, "Password Needed"
  126.    Else
  127.       If Len(Text2.Text) > 20 Then
  128.          Text2.Text = Left(Text2.Text, 20)
  129.       End If
  130.       For i = 1 To Len(Text2.Text)
  131.          Key(i) = Asc(Mid(Text2.Text, i, 1)) + i
  132.       Next
  133.       i = 1
  134.       Open "c:\coded.dat" For Random As #1 Len = Len(crypt)
  135.       
  136.       'Divide the file length (bytes) by 2. We used integers
  137.       'which take 2 bytes each...
  138.       
  139.       filelength = LOF(1) / 2
  140.       For n = 1 To filelength
  141.          Get #1, n, crypt.code
  142.          temp = Chr(Abs(crypt.code - Key(i)))
  143.          i = i + 1
  144.          If i > Len(Text2.Text) Then
  145.             i = 1
  146.          End If
  147.          Text1.Text = Text1.Text & temp
  148.       Next
  149.       Close #1
  150.    End If
  151.  
  152. End Sub
  153.  
  154.  
  155.